home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / aedesc.tcl < prev    next >
Encoding:
Text File  |  2001-01-03  |  18.6 KB  |  581 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  TclAE - Descriptor data structure functions for AEGizmo values
  4.  # 
  5.  #  FILE: "aedesc.tcl"
  6.  #                                    created: 7/28/99 {6:55:33 PM} 
  7.  #                                last update: 1/3/01 {5:11:14 PM} 
  8.  #                                    version: 1.0
  9.  #  Author: Jonathan Guyer
  10.  #  E-mail: jguyer@his.com
  11.  #    mail: Alpha Cabal
  12.  #          POMODORO no seisan
  13.  #     www: http://www.his.com/jguyer/
  14.  #  
  15.  # ========================================================================
  16.  #               Copyright (c) 1999-2001 Jonathan Guyer
  17.  #                         All rights reserved
  18.  # ========================================================================
  19.  # Permission to use, copy, modify, and distribute this software and its
  20.  # documentation for any purpose and without fee is hereby granted,
  21.  # provided that the above copyright notice appear in all copies and that
  22.  # both that the copyright notice and warranty disclaimer appear in
  23.  # supporting documentation.
  24.  # 
  25.  # Jonathan Guyer disclaims all warranties with regard to this software,
  26.  # including all implied warranties of merchantability and fitness.  In
  27.  # no event shall Jonathan Guyer be liable for any special, indirect or
  28.  # consequential damages or any damages whatsoever resulting from loss of
  29.  # use, data or profits, whether in an action of contract, negligence or
  30.  # other tortuous action, arising out of or in connection with the use or
  31.  # performance of this software.
  32.  # ========================================================================
  33.  #  Description: 
  34.  # 
  35.  #  History
  36.  # 
  37.  #  modified   by  rev reason
  38.  #  ---------- --- --- -----------
  39.  #  1999-07-28 JEG 1.0 original
  40.  # ###################################################################
  41.  ##
  42.  
  43. namespace eval tclAE::desc {}
  44. namespace eval tclAE::subdesc {}
  45.  
  46. proc tclAE::desc {} {}
  47.  
  48. if {([info tclversion] < 8.0)
  49. ||    ![info exists tclAE_version] 
  50. ||  ($tclAE_version < 2.0)} {
  51.     
  52. # ◊◊◊◊ TclAE objects ◊◊◊◊ #
  53.  
  54. proc tclAE::desc::isDescriptor {theAEDesc} {
  55.     global tclAE::desc::wildcard $theAEDesc
  56.     
  57.     return [expr {[string match ${tclAE::desc::wildcard} $theAEDesc] \
  58.       && [info exists $theAEDesc]}]
  59. }
  60.  
  61. proc tclAE::subdesc::isSubDescriptor {theAESubDesc} {
  62.     global tclAE::subdesc::wildcard $theAESubDesc
  63.     
  64.     return [expr {[string match ${tclAE::subdesc::wildcard} $theAESubDesc] \
  65.       && [info exists $theAESubDesc]}]
  66. }
  67.  
  68. ################################################################
  69. #                                                              #
  70. #   GET AWAY FROM HERE! THIS STUFF IS NONE OF YOUR BUSINESS!   #
  71. #                                                              #
  72. ################################################################
  73.  
  74. ensureset tclAE::desc::_next -1
  75. ensureset tclAE::subdesc::_next -1
  76.  
  77. ## 
  78.  # -------------------------------------------------------------------------
  79.  # 
  80.  # "tclAE::desc::_form" --
  81.  # 
  82.  # Results:
  83.  #  AEDesc identifier for the item numbered $index.
  84.  # -------------------------------------------------------------------------
  85.  ##
  86. proc tclAE::desc::_form {index} {
  87.     # This should be the only place the descriptor syntax is hard-coded
  88.     return "tclAEDesc.$index"
  89. }
  90.  
  91. ## 
  92.  # -------------------------------------------------------------------------
  93.  # 
  94.  # "tclAE::subdesc::_form" --
  95.  # 
  96.  # Results:
  97.  #  AESubDesc identifier for the item numbered $index.
  98.  # -------------------------------------------------------------------------
  99.  ##
  100. proc tclAE::subdesc::_form {index} {
  101.     # This should be the only place the sub-descriptor syntax is hard-coded
  102.     return "tclAESubDesc.$index"
  103. }
  104.  
  105. proc tclAE::desc::inheritDescriptor {typeCode fromType} {
  106.     global tclAE::desc::procs
  107.     
  108.     foreach method [array names tclAE::desc::procs "[quote::Find ${fromType}].*"] {
  109.         set tclAE::desc::procs(${typeCode}[string range $method 4 end]) \
  110.           [set tclAE::desc::procs($method)]
  111.     }
  112. }
  113.  
  114. set  tclAE::desc::wildcard   [tclAE::desc::_form "*"]
  115. set  tclAE::subdesc::wildcard   [tclAE::subdesc::_form "*"]
  116.  
  117.  
  118. tclAE::desc::inheritDescriptor "****" ""
  119.  
  120. set tclAE::desc::procs(****.coerceDesc)        tclAE::desc::_****_coerceDesc
  121. set tclAE::desc::procs(****.disposeDesc)    tclAE::desc::_****_disposeDesc
  122. set tclAE::desc::procs(****.duplicateDesc)    tclAE::desc::_****_duplicateDesc
  123. set tclAE::desc::procs(****.getData)        tclAE::desc::_****_getData
  124. set tclAE::desc::procs(****.print)        tclAE::desc::_****_print
  125.  
  126. set tclAE::desc::procs(enum.getData)        tclAE::desc::_enum_getData
  127.  
  128. tclAE::desc::inheritDescriptor "list" "****"
  129.  
  130. set tclAE::desc::procs(list.coerceDesc)        tclAE::desc::_list_coerceDesc
  131. set tclAE::desc::procs(list.countItems)        tclAE::desc::_list_countItems
  132. set tclAE::desc::procs(list.deleteItem)        tclAE::desc::_list_deleteItem
  133. set tclAE::desc::procs(list.disposeDesc)    tclAE::desc::_list_disposeDesc
  134. set tclAE::desc::procs(list.duplicateDesc)    tclAE::desc::_list_duplicateDesc
  135. set tclAE::desc::procs(list.getData)        tclAE::desc::_list_getData
  136. set tclAE::desc::procs(list.getNthData)        tclAE::desc::_list_getNthData
  137. set tclAE::desc::procs(list.getNthDesc)        tclAE::desc::_list_getNthDesc
  138. set tclAE::desc::procs(list.putData)        tclAE::desc::_list_putData
  139. set tclAE::desc::procs(list.putDesc)        tclAE::desc::_list_putDesc
  140. set tclAE::desc::procs(list.print)        tclAE::desc::_list_print
  141.  
  142.  
  143. tclAE::desc::inheritDescriptor "reco" "list"
  144.  
  145. set tclAE::desc::procs(reco.coerceDesc)        tclAE::desc::_reco_coerceDesc
  146. set tclAE::desc::procs(reco.deleteItem)        tclAE::desc::_reco_deleteItem
  147. set tclAE::desc::procs(reco.deleteKeyDesc)    tclAE::desc::_reco_deleteKeyDesc
  148. set tclAE::desc::procs(reco.disposeDesc)    tclAE::desc::_reco_disposeDesc
  149. set tclAE::desc::procs(reco.duplicateDesc)    tclAE::desc::_reco_duplicateDesc
  150. set tclAE::desc::procs(reco.getKeyData)        tclAE::desc::_reco_getKeyData
  151. set tclAE::desc::procs(reco.getKeyDesc)        tclAE::desc::_reco_getKeyDesc
  152. set tclAE::desc::procs(reco.getNthData)        tclAE::desc::_reco_getNthData
  153. set tclAE::desc::procs(reco.getNthDesc)        tclAE::desc::_reco_getNthDesc
  154. set tclAE::desc::procs(reco.putData)        tclAE::desc::_reco_putData
  155. set tclAE::desc::procs(reco.putDesc)        tclAE::desc::_reco_putDesc
  156. set tclAE::desc::procs(reco.putKeyData)        tclAE::desc::_reco_putKeyData
  157. set tclAE::desc::procs(reco.putKeyDesc)        tclAE::desc::_reco_putKeyDesc
  158. set tclAE::desc::procs(reco.print)        tclAE::desc::_reco_print
  159.  
  160. # The AEM seems to allow these, but they don't really mean anything for a 'reco'
  161. unset tclAE::desc::procs(reco.getData)
  162. # unset tclAE::desc::procs(reco.putDesc)
  163.  
  164.  
  165. tclAE::desc::inheritDescriptor "aevt" "reco"
  166.  
  167. set tclAE::desc::procs(aevt.duplicateDesc)    tclAE::desc::_aevt_duplicateDesc
  168.  
  169.  
  170.  
  171. # ◊◊◊◊  '****' method handlers  ◊◊◊◊ #
  172.  
  173. proc tclAE::desc::_****_coerceDesc {theAEDesc toType} {
  174.     global $theAEDesc
  175.     
  176.     set typeCode [set ${theAEDesc}(descriptorType)]
  177.     set data [set ${theAEDesc}(dataRecord)]
  178.     
  179.     return [tclAE::coerceData $typeCode $data $toType]
  180. }
  181.  
  182. proc tclAE::desc::_****_disposeDesc {theAEDesc} {
  183.     global $theAEDesc
  184.     unset $theAEDesc
  185. }
  186.  
  187. proc tclAE::desc::_****_duplicateDesc {theAEDesc} {
  188.     global $theAEDesc
  189.     
  190.     return [tclAE::createDesc [set ${theAEDesc}(descriptorType)] \
  191.       [set ${theAEDesc}(dataRecord)]]
  192. }
  193.  
  194. proc tclAE::desc::_****_getData {theAEDesc {desiredType ****} {typeCodePtr ""}} {
  195.     global $theAEDesc
  196.     
  197.     upvar $typeCodePtr typeCode
  198.     
  199.     set descriptorType [set ${theAEDesc}(descriptorType)]
  200.     set data [set ${theAEDesc}(dataRecord)]  
  201.     
  202.     switch $desiredType {
  203.         "****" {
  204.             set typeCode $descriptorType
  205.             switch $typeCode {
  206.                 "TEXT" {
  207.                     set data [coerce TEXT -x $data TEXT]
  208.                 }
  209.                 "bool" {
  210.                     set data [expr "0x${data}"]
  211.                 }
  212.                 "shor" {
  213.                     set data [coerce shor -x $data TEXT]
  214.                 }
  215.                 "long" {
  216.                     set data [coerce long -x $data TEXT]
  217.                 }
  218.                 "sing" {
  219.                     set data [coerce sing -x $data TEXT]
  220.                 }
  221.                 "doub" {
  222.                     set data [coerce doub -x $data TEXT]
  223.                 }
  224.             }
  225.         }
  226.         "????" {
  227.             set typeCode $descriptorType
  228.         }
  229.         default {
  230.             set typeCode $desiredType
  231.             set outAEDesc [tclAE::coerceData $descriptorType $data $desiredType]
  232.             set data [tclAE::desc::_****_getData $outAEDesc]
  233.             tclAE::disposeDesc $outAEDesc
  234.         }
  235.     }
  236.     
  237.     return $data
  238. }
  239.  
  240. proc tclAE::desc::_enum_getData {theAEDesc {desiredType ****} {typeCodePtr ""}} {
  241.     set data [tclAE::desc::_****_getData $theAEDesc $desiredType $typeCodePtr]
  242.     binary scan $data a4 enum
  243.     
  244.     return $enum
  245. }
  246.  
  247. # ◊◊◊◊  'list' method handlers  ◊◊◊◊ #
  248.  
  249. proc tclAE::desc::_list_coerceDesc {theAEDescList toType} {
  250.     global $theAEDescList
  251.     
  252.     if {$toType == "****"} {
  253.         return [tclAE::desc::_list_duplicateDesc $theAEDescList]
  254.     } else {
  255.         set items [set ${theAEDescList}(dataRecord)]
  256.         if {[llength $items] != 1} {
  257.             # Can only coerce a one-item list
  258.             error::throwOSErr -1700 "Couldn't coerce descriptor to '${toType}'"
  259.         } 
  260.         
  261.         return [tclAE::coerceDesc [lindex $items 0] $toType]
  262.     }
  263. }
  264.  
  265. proc tclAE::desc::_list_countItems {theAEDescList} {
  266.     global $theAEDescList
  267.     return [llength [set ${theAEDescList}(dataRecord)]]    
  268. }    
  269.  
  270. proc tclAE::desc::_list_deleteItem {theAEDescList index} {
  271.     global $theAEDescList
  272.     
  273.     set data [set ${theAEDescList}(dataRecord)]
  274.     if {($index < 0) 
  275.     ||  ($index >= [llength $data])} {
  276.         # index out of range
  277.         error::throwOSErr -1719 "Couldn't delete item from \"${theAEDescList}\""
  278.     } 
  279.     # remove the item
  280.     tclAE::disposeDesc [lindex $data $index]
  281.     set ${theAEDescList}(dataRecord) [lreplace $data $index $index]
  282. }
  283.  
  284. proc tclAE::desc::_list_disposeDesc {theAEDescList} {
  285.     global $theAEDescList
  286.     
  287.     # Destroy the list elements
  288.     foreach item [set ${theAEDescList}(dataRecord)] {
  289.         tclAE::disposeDesc $item
  290.     }
  291.     
  292.     # Destroy the list data
  293.     unset $theAEDescList
  294. }
  295.  
  296. proc tclAE::desc::_list_duplicateDesc {theAEDescList} {
  297.     global $theAEDescList
  298.     
  299.     set newAEDescList [tclAE::createList]
  300.     global $newAEDescList
  301.     set ${newAEDescList}(descriptorType) [set ${newAEDescList}(descriptorType)]
  302.     
  303.     # Duplicate the list items
  304.     foreach item [set ${theAEDescList}(dataRecord)] {
  305.         lappend ${newAEDescList}(dataRecord) \
  306.           [tclAE::_duplicateDesc $item]
  307.     }
  308.     
  309.     return $newAEDescList
  310. }
  311.  
  312. proc tclAE::desc::_list_getData {theAEDescList {desiredType ****} {typeCodePtr ""}} {
  313.     global $theAEDescList
  314.     
  315.     upvar $typeCodePtr typeCode
  316.     set typeCode [set ${theAEDescList}(descriptorType)]
  317.     
  318.     foreach item [set ${theAEDescList}(dataRecord)] {
  319.         lappend data [tclAE::getData $item $desiredType]    
  320.     }
  321.     
  322.     return $data
  323. }
  324.  
  325. proc tclAE::desc::_list_getNthData {theAEDescList index {desiredType ****} {theAEKeywordPtr ""} {typeCodePtr ""}} {
  326.     global $theAEDescList
  327.     
  328.     set data [set ${theAEDescList}(dataRecord)]
  329.     if {($index < 0) 
  330.     ||  ($index >= [llength $data])} {
  331.         # index out of range
  332.         error::throwOSErr -1719 "Couldn't get item #${index} from \"${theAEDescList}\""
  333.     } 
  334.     upvar $theAEKeywordPtr theAEKeyword
  335.     upvar $typeCodePtr typeCode
  336.     
  337.     set theAEKeyword "****"
  338.     
  339.     return [tclAE::getData [lindex $data $index] $desiredType typeCode]
  340. }
  341.  
  342. proc tclAE::desc::_list_getNthDesc {theAEDescList index {desiredType ****} {theAEKeywordPtr ""}} {
  343.     global $theAEDescList
  344.     
  345.     set data [set ${theAEDescList}(dataRecord)]
  346.     if {($index < 0) 
  347.     ||  ($index >= [llength $data])} {
  348.         # index out of range
  349.         error::throwOSErr -1719 "Couldn't get item #${index} from \"${theAEDescList}\""
  350.     } 
  351.     upvar $theAEKeywordPtr theAEKeyword
  352.     
  353.     set theAEKeyword "****"
  354.     
  355.     return [tclAE::coerceDesc [lindex $data $index] $desiredType]
  356. }
  357.  
  358. proc tclAE::desc::_list_putDesc {theAEDescList index theAEDesc} {
  359.     global $theAEDescList
  360.     
  361.     set items [set ${theAEDescList}(dataRecord)]
  362.     
  363.     set copyAEDesc [tclAE::duplicateDesc $theAEDesc]
  364.     
  365.     if {($index < 0) || ($index == "end")} {
  366.         lappend ${theAEDescList}(dataRecord) $copyAEDesc
  367.     } elseif {$index >= [llength $items]} {
  368.         # index out of range
  369.         error::throwOSErr -1719 "Couldn't put AEDesc into item #${index} of \"${theAEDescList}\""
  370.     } else {
  371.         # Dispose of any AEDesc that may already be in this position
  372.         catch {tclAE::disposeDesc [lindex $items $index]}
  373.         
  374.         set ${theAEDescList}(dataRecord) \
  375.           [lreplace $items $index $index $copyAEDesc]
  376.     }
  377. }
  378.  
  379. # ◊◊◊◊  'reco' method handlers  ◊◊◊◊ #
  380.  
  381. proc tclAE::desc::_reco_coerceDesc {theAERecord toType} {
  382.     set newAERecord [tclAE::_duplicateDesc $theAERecord]
  383.     
  384.     global $newAERecord
  385.     set ${newAERecord}(descriptorType) $toType
  386.     
  387.     return $newAERecord
  388. }
  389.  
  390. proc tclAE::desc::_reco_deleteItem {theAERecord index} {
  391.     global $theAERecord
  392.     
  393.     set data [set ${theAERecord}(dataRecord)]
  394.     if {($index < 0) 
  395.     ||  ($index >= [llength $data]} {
  396.         # index out of range
  397.         error::throwOSErr -1719 "Couldn't delete item from \"${theAERecord}\""
  398.     } 
  399.     set keyword [lindex $data $index]
  400.     
  401.     # remove the item
  402.     tclAE::disposeDesc [set ${theAERecord}($keyword)]
  403.     unset ${theAERecord}($keyword)
  404.     set ${theAERecord}(dataRecord) [lreplace $data $index $index]
  405. }
  406.  
  407. proc tclAE::desc::_reco_deleteKeyDesc {theAERecord theAEKeyword} {
  408.     global $theAERecord
  409.     
  410.     if {![info exists ${theAERecord}($theAEKeyword)]} {
  411.         # no such keyword
  412.         error::throwOSErr -1719    "Couldn't delete keyword '${theAEKeyword}' from \"${theAERecord}\""    
  413.     } 
  414.     
  415.     # Dispose of the keyword data descriptor
  416.     tclAE::disposeDesc [set ${theAERecord}($theAEKeyword)]
  417.     
  418.     # Delete keyword
  419.     unset ${theAERecord}($theAEKeyword)    
  420.     set ${theAERecord}(dataRecord) \
  421.       [lremove -all -- [set ${theAERecord}(dataRecord)] $theAEKeyword]
  422. }
  423.  
  424. proc tclAE::desc::_reco_disposeDesc {theAERecord} {
  425.     global $theAERecord
  426.     
  427.     # Destroy the record fields
  428.     foreach keyword [set ${theAERecord}(dataRecord)] {
  429.         tclAE::disposeDesc [set ${theAERecord}($keyword)]
  430.     }
  431.     
  432.     # Destroy the record data
  433.     unset $theAERecord
  434. }
  435.  
  436. proc tclAE::desc::_reco_duplicateDesc {theAERecord} {
  437.     global $theAERecord
  438.     
  439.     set newAERecord [tclAE::createList 1]
  440.     global $newAERecord
  441.     set ${newAERecord}(descriptorType) [set ${theAERecord}(descriptorType)]
  442.     
  443.     # Duplicate the record fields
  444.     foreach keyword [set ${theAERecord}(dataRecord)] {
  445.         set ${newAERecord}($keyword) \
  446.           [tclAE::_duplicateDesc [set ${theAERecord}($keyword)]]
  447.         
  448.         lappend ${newAERecord}(dataRecord) $keyword
  449.     }
  450.     
  451.     return $newAERecord
  452. }
  453.  
  454. proc tclAE::desc::_reco_getKeyData {theAERecord theAEKeyword {desiredType ****} {typeCodePtr ""}} {
  455.     global $theAERecord
  456.     
  457.     set theAEKeyword [format "%-4.4s" $theAEKeyword]
  458.     
  459.     if {![info exists ${theAERecord}($theAEKeyword)]} {
  460.         # no such keyword
  461.         error::throwOSErr -1719 "Couldn't get keyword '${theAEKeyword}' from \"${theAERecord}\""
  462.     }
  463.     
  464.     set theAEDesc [set ${theAERecord}($theAEKeyword)]
  465.     
  466.     upvar $typeCodePtr typeCode
  467.     set data [tclAE::getData $theAEDesc $desiredType typeCode]
  468.     
  469.     return $data
  470. }
  471.  
  472. proc tclAE::desc::_reco_getKeyDesc {theAERecord theAEKeyword {desiredType ****}} {
  473.     global $theAERecord
  474.     
  475.     set theAEKeyword [format "%-4.4s" $theAEKeyword]
  476.     
  477.     if {![info exists ${theAERecord}($theAEKeyword)]} {
  478.         # no such keyword
  479.         error::throwOSErr -1719 "Couldn't get keyword '${theAEKeyword}' from \"${theAERecord}\""    
  480.     }
  481.     
  482.     set theAEDesc [set ${theAERecord}($theAEKeyword)]
  483.     
  484.     return [tclAE::coerceDesc $theAEDesc $desiredType]
  485. }
  486.  
  487. proc tclAE::desc::_reco_getNthData {theAERecord index {desiredType ****} {theAEKeywordPtr ""} {typeCodePtr ""}} {
  488.     global $theAERecord
  489.     
  490.     set data [set ${theAERecord}(dataRecord)]
  491.     if {($index < 0) 
  492.     ||  ($index >= [llength $data])} {
  493.         # index out of range
  494.         error::throwOSErr -1719 "Couldn't get item #${index} from \"${theAERecord}\""
  495.     } 
  496.     upvar $theAEKeywordPtr theAEKeyword
  497.     upvar $typeCodePtr typeCode
  498.     
  499.     set theAEKeyword [lindex $data $index]
  500.     
  501.     return [tclAE::desc::_reco_getKeyData $theAERecord $theAEKeyword \
  502.       $desiredType typeCode]
  503. }
  504.  
  505. proc tclAE::desc::_reco_getNthDesc {theAERecord index {desiredType ****} {theAEKeywordPtr ""}} {
  506.     global $theAERecord
  507.     
  508.     set data [set ${theAERecord}(dataRecord)]
  509.     if {($index < 0) 
  510.     ||  ($index >= [llength $data])} {
  511.         # index out of range
  512.         error::throwOSErr -1719 "Couldn't get item #${index} from \"${theAERecord}\""
  513.     } 
  514.     upvar $theAEKeywordPtr theAEKeyword    
  515.     set theAEKeyword [lindex $data $index]
  516.     
  517.     return [tclAE::desc::_reco_getKeyDesc $theAERecord $theAEKeyword $desiredType]
  518. }
  519.  
  520. proc tclAE::desc::_reco_putDesc {theAERecord index theAEDesc} {
  521.     global $theAERecord
  522.     
  523.     set keywords [set ${theAERecord}(dataRecord)]
  524.     
  525.     if {($index < 0) || ($index >= [llength $keywords])} {
  526.         # index out of range
  527.         error::throwOSErr -1719 "Couldn't put AEDesc into item #${index} of \"${theAERecord}\""
  528.     } else {
  529.         tclAE::desc::_reco_putKeyDesc $theAERecord [lindex $keywords $index] $theAEDesc
  530.     }
  531. }
  532.  
  533. proc tclAE::desc::_reco_putKeyDesc {theAERecord theAEKeyword theAEDesc} {
  534.     global $theAERecord
  535.     
  536.     set theAEKeyword [format "%-4.4s" $theAEKeyword]
  537.     
  538.     # Dispose of any AEDesc that may already be in this position
  539.     if {[info exists ${theAERecord}($theAEKeyword)]} {
  540.         catch {tclAE::disposeDesc [set ${theAERecord}($theAEKeyword)]}
  541.     } 
  542.     
  543.     set ${theAERecord}($theAEKeyword) [tclAE::duplicateDesc $theAEDesc]
  544.     
  545.     if {[lsearch -exact [set ${theAERecord}(dataRecord)] $theAEKeyword] == -1} {
  546.         lappend ${theAERecord}(dataRecord) $theAEKeyword    
  547.     } 
  548. }
  549.  
  550. # ◊◊◊◊  'aevt' method handlers ◊◊◊◊ #
  551.  
  552. # proc tclAE::desc::_aevt_send {level theAppleEvent $args} {
  553. #     global $theAppleEvent
  554. #     
  555. #     set out [set ${theAppleEvent}(evcl)]
  556. #     lappend out [set ${theAppleEvent}(evid)]
  557. #     
  558. #     foreach keyword [set ${theAppleEvent}(dataRecord)] {
  559. #         lappend out [tclAE::build::protect $keyword]
  560. #         lappend    out [[set ${theAppleEvent}($keyword)] print]
  561. #     }
  562. #     return [eval tclAE::send $args $out]
  563. # }
  564.  
  565. }
  566.  
  567. proc tclAE::desc::_aevt_duplicateDesc {theAppleEvent} {
  568.     set newAppleEvent [tclAE::desc::_reco_duplicateDesc $theAppleEvent]
  569.     
  570.     global $theAppleEvent $newAppleEvent
  571.     
  572.     set ${newAppleEvent}(basicType)        "aevt"
  573.     set ${newAppleEvent}(evcl)            [set ${theAppleEvent}(evcl)]
  574.     set ${newAppleEvent}(evid)            [set ${theAppleEvent}(evid)]
  575.     
  576.     return $newAppleEvent
  577. }
  578.  
  579.  
  580.  
  581.